Visual Basic Toolbox/Visual Basic Toolbox (P.I.E.)(1996).ISO/buttons/btndmo/cbuttons.cls

Text File | 1995-10-01 | 11KB | 354 lines

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
END
Attribute VB_Name = "CButtons"
Attribute VB_Creatable = True
Attribute VB_Exposed = False
Option Explicit

'Maximum number of buttons allowed per container
Const MAX_BUTTONS = 50

'The size of the bitmap; both height and width
Const BTN_SIZE = 195    'Twips

'Minimum space between buttons; no overlapping allowed
Const MIN_BUTTON_OFFSET = BTN_SIZE

'Appearance
Const BTN_FLAT = 1
Const BTN_3D = 2

'3D button res file images
Const IDB_BTN3DTRUE = 100
Const IDB_BTN3DFALSE = 101
Const IDB_BTN3DTRUE_FOCUS = 102
Const IDB_BTN3DFALSE_FOCUS = 103

'Normal res file button images
Const IDB_BTNTRUE = 105
Const IDB_BTNFALSE = 106
Const IDB_BTNTRUE_FOCUS = 107
Const IDB_BTNFALSE_FOCUS = 108

'Picturebox that is used as container
Private m_picContainer As PictureBox

'*************************************
' Properties
'*************************************
'Number of buttons in container
Private m_Buttons As Byte

'Space between each button
Private m_ButtonOffset As Integer

'Button that currently is selected in
'group; 0 = None
Private m_Value As Byte

'Appearance of buttons; 3D or FLAT
Private m_Appearance As Byte
Private Function ButtonHit%(X%, Y%)
    Dim i%
    Dim offset%
    Dim BtnSizeX%
    Dim BtnSizeY%
    Dim rc As RECT
    #If Win16 Then
        'Must be integer for 16 bit
        Dim X1%
        Dim Y1%
    #ElseIf Win32 Then
        'Must be long for 32 bit
        Dim X1&
        Dim Y1&
    #End If

    X1 = X
    Y1 = Y

    'PtInRect, works faster in pixels than it twips.
    offset% = m_ButtonOffset% / Screen.TwipsPerPixelX
    BtnSizeX% = BTN_SIZE / Screen.TwipsPerPixelX
    BtnSizeY% = BTN_SIZE / Screen.TwipsPerPixelY

    'This demo/class does not support a custom top property
    'for each button; therefore the top of all buttons
    'is zero -- the top of the container -- and the
    'bottom is always the same for each button.
    rc.Top = 0
    rc.Bottom = BtnSizeY%

    For i% = 1 To m_Buttons
        'Calculate the left and width of each button; the
        'top and height are the same for each button and
        'do not need to be recalculated.
        rc.Left = (i% - 1) * offset%
        rc.Right = rc.Left + BtnSizeX%

        'Test for a hit in the rect; if so,
        'then return the button value and exit
        #If Win16 Then
            'Parameters must be in order of Y, X
            'which is opposite to Win32
            If PtInRect(rc, Y1, X1) Then
                ButtonHit% = i%
                Exit Function
            End If
        #ElseIf Win32 Then
            'Parameters must be in order of X, Y
            'which is opposite to Win16
            If PtInRect(rc, X1, Y1) Then
                ButtonHit% = i%
                Exit Function
            End If
        #End If
    Next i%
    ButtonHit% = 0
End Function


Public Function InitializeClass(pic As PictureBox) As Boolean
    'The VB implementation of the Class_Initialize
    'event does not allow for the passing of parameters;
    'therefore we must use a 'custom' initialize event.

    'Trap errors and return false if any
    On Error GoTo InitERR:

    'Assig the passed picturebox to the private
    'class picturebox variable.  This allows the
    'class code to be self-contained/generic to the
    'class itself; as the implementation of the class
    'focuses on acting upon the container this variable
    'must be set before any other methods/properties
    'can be used.
    Set m_picContainer = pic

    'The default appearance implementation is 3D.  By
    'setting the property here it will cause the button/
    'container to be originally shown as 3D.  This only
    'makes a difference when the class is initialized after
    'the form has loaded.  If the class is initialized in
    'the form load event then it has no bearing on the
    'acutal appearance as the programmer can reset the
    'apperance in code before the user sees the form painted
    '(as per this demo -- see the Form_Load event for details).
    Appearance() = BTN_3D

    'Success
    InitializeClass = True
Exit Function
InitERR:
    'Indicate initialization failure
    InitializeClass = False
    Exit Function
End Function
Public Sub KeyDown(KeyCode As Integer, Shift As Integer)
    'Allow the user to select the current
    'button by moving through the group using
    'the direction keys; this has the same
    'effect as per normal option buttons.

    Select Case KeyCode
    Case vbKeyLeft, vbKeyUp
        Select Case m_Value
        Case 0
            Value() = 1
        Case 1
            Value() = m_Buttons
        Case Else
            Value() = m_Value - 1
        End Select
    Case vbKeyDown, vbKeyRight
        Select Case m_Value
        Case 0
            Value() = 1
        Case m_Buttons
            Value() = 1
        Case Else
            Value() = m_Value + 1
        End Select
    End Select
End Sub


Public Sub MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    Dim BtnHit%

    'Only proccess the "Hit" if the left mouse button
    'is pressed by itself.
    If (Button <> vbLeftButton) And (Shift <> 0) Then Exit Sub

    'Check for a mouse hit on a button
    BtnHit% = ButtonHit%(X / Screen.TwipsPerPixelX, Y / Screen.TwipsPerPixelY)

    'If a button was hit then set that button
    'as the currently selected button
    Select Case BtnHit%
    Case 1 To m_Buttons
        Value() = BtnHit%
    End Select
End Sub

Public Sub Refresh()
    Dim i%
    Dim btnT%
    Dim btnTF%
    Dim btnF%
    Dim btnFF%

    'The button images/bmps used to draw the
    'buttons are stored in a *.res file.
    'In this demo, there are only two sets of
    'images; 3D or FLAT with or without focus.

    'If you want greater flexibility in how the buttons
    'appear, then you could substitute the res file button
    'image for graphics methods (i.e. Cirle, etc) or
    'store more bitmaps in the res file.

    'By using procedure level variables in the actual
    'code that draws the buttons, we can use the same code
    'to draw the buttons for each different appearance.
    'This is done by assigning the appropriate res file
    'index values according to the desired button group
    'we want (in this demo there are only two but in
    'reality there could be more).
    Select Case m_Appearance
    Case BTN_3D
        btnT% = IDB_BTN3DTRUE
        btnTF% = IDB_BTN3DTRUE_FOCUS
        btnF% = IDB_BTN3DFALSE
        btnFF% = IDB_BTN3DFALSE_FOCUS
    Case BTN_FLAT
        btnT% = IDB_BTNTRUE
        btnTF% = IDB_BTNTRUE_FOCUS
        btnF% = IDB_BTNFALSE
        btnFF% = IDB_BTNFALSE_FOCUS
    End Select

    'If a *.res file is not available, then you could store
    'the button pictures in image controls and use the
    'Picture property as the source for PaintPicture, i.e.
    'm_picContainer.PaintPicture Form1.imgBtn3dTrue.Picture, ...etc

    For i% = 1 To m_Buttons
        If i% = m_Value Then
            'We can determine if the picturebox has the focus
            'by checking if the parent activecontrol is the
            'picturebox.
            If m_picContainer Is m_picContainer.Parent.ActiveControl Then
                'Button is selected, with focus
                m_picContainer.PaintPicture _
                    LoadResPicture(btnTF%, vbResBitmap), _
                    (i% - 1) * m_ButtonOffset, 0
            Else
                'Button is selected, without focus
                m_picContainer.PaintPicture _
                    LoadResPicture(btnT%, vbResBitmap), _
                    (i% - 1) * m_ButtonOffset, 0
            End If
        Else
            'Button is not selected, without focus
            m_picContainer.PaintPicture _
                LoadResPicture(btnF%, vbResBitmap), _
                (i% - 1) * m_ButtonOffset, 0
        End If
    Next i%

    If m_Value = 0 Then
        If m_picContainer Is m_picContainer.Parent.ActiveControl Then
            'Button is not selected, with focus
            m_picContainer.PaintPicture _
                LoadResPicture(btnFF%, vbResBitmap), 0, 0
        End If
    End If
End Sub

Private Sub Class_Initialize()
    m_Buttons = 1
    m_ButtonOffset = 240
End Sub

Private Sub Class_Terminate()
    Set m_picContainer = Nothing
End Sub


Public Property Get Buttons() As Byte
    Buttons = m_Buttons
End Property

Public Property Let Buttons(NewValue As Byte)
    Select Case NewValue
    Case 1 To MAX_BUTTONS
        m_Buttons = NewValue
        Refresh
    Case Else
        MsgBox "Invalid property setting: Buttons = " & NewValue
    End Select
End Property

Public Property Get ButtonOffset() As Integer
    ButtonOffset = m_ButtonOffset
End Property


Public Property Let ButtonOffset(NewValue As Integer)
    Select Case NewValue
    Case Is >= MIN_BUTTON_OFFSET
        m_ButtonOffset = NewValue
        Refresh
    Case Else
        MsgBox "Invalid property setting: ButtonOffset = " & NewValue
    End Select
End Property


Public Property Get Value() As Byte
    Value = m_Value
End Property

Public Property Let Value(NewValue As Byte)
    Select Case NewValue
    Case 0 To m_Buttons
        m_Value = NewValue
        Refresh
    Case Else
        MsgBox "Invalid property setting: Value = " & NewValue
    End Select
End Property

Public Property Get Appearance() As Byte
    Appearance = m_Appearance
End Property

Public Property Let Appearance(NewValue As Byte)
    'This color is hardcoded into the procedure
    'vice using vbButtonFace because the bitmaps
    'used for the buttons were created with this
    'color value of light grey.
    Const LT_GRAY = &HC0C0C0

    Select Case NewValue
    Case BTN_FLAT, BTN_3D
        If m_Appearance <> NewValue Then
            m_Appearance = NewValue
            Select Case m_Appearance
            Case BTN_3D
                m_picContainer.BackColor = LT_GRAY
            Case BTN_FLAT
                m_picContainer.BackColor = vbWhite
            End Select
            Refresh
        End If
    Case Else
        MsgBox "Invalid property setting: Appearance = " & NewValue
    End Select
End Property